PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/basic/qbcref.com/QBCREF.BAS

BASIC Source File | 1990-04-30 | 20.5 KB | 794 lines

'----------------------------------------------------------------------------
'Program: QBCREF
'Purpose: Basic Cross Reference Program
'Author : Greg Tesch
'History: 27-Dec-1989 Initial Version 1.00
'       : 15-Jan-1989 V 1.10 (Macro Calls)
'       : 18-Jan-1989 V 1.20 (New BldIdent)
'       : 14-Apr-1990 V 1.21 (Fix Stmt Xref Problems)
'       : 29-Apr-1990 V 1.22 (CTRL/C Trap Routine)
'----------------------------------------------------------------------------
REM $STATIC                                 ' STATIC Array Allocation
DEFINT A-Z
'
'   Global Constants
'
CONST Version = "1.22"
CONST FALSE = 0, TRUE = NOT FALSE
CONST WideSize = 96                         ' Width of Listing when /W
CONST NULL$ = ""                            ' Null String
CONST NUL = 0                               ' Null Value
CONST MaxTokenSz = 40                       ' Maximum Token Size
CONST MaxNode = 1000                        ' Maximum Token Elements
CONST DefLines = 60                         ' Default line count
CONST DefTab = 4                            ' Default Tab size
CONST Ident = 1, Literal = 2, Label = 3     ' Token Types
'
'   Global Type Definitions
'
TYPE TokenNode                              ' Token Table Element
    Left AS INTEGER                         ' Left Element Number
    Right AS INTEGER                        ' Rigth Element Number
    Flag AS STRING * 1                      ' Key   Word Flag
    Token AS STRING * MaxTokenSz            ' Stored Token
END TYPE

TYPE StackNode                              ' Stack Table Element
    NodeLink AS INTEGER                     ' Element in Token Table
    StackLink AS INTEGER                    ' Next Element In Stack
END TYPE
'
'   Declare External Functions and Subs
'
DECLARE FUNCTION CkKeyWd (Arg AS STRING)
DECLARE FUNCTION NodeCmp (Token AS STRING, SEG Node AS TokenNode)
DECLARE SUB SetCtrlC ()
'
'   Declare Basic Functions and Subs
'
DECLARE FUNCTION Abort ()
DECLARE FUNCTION HaveCmdParams ()
DECLARE FUNCTION IsKeyWord ()
DECLARE FUNCTION InclStmt ()
DECLARE FUNCTION IsSpecial (NextWord AS STRING)
DECLARE FUNCTION GetToken (CurPos AS INTEGER, EndPos AS INTEGER)
DECLARE SUB BldIdent (StartPos AS INTEGER, EndPos AS INTEGER)
DECLARE SUB BldLiteral (StartPos AS INTEGER, EndPos AS INTEGER)
DECLARE SUB BldLabel (StartPos AS INTEGER, EndPos AS INTEGER)
DECLARE SUB InsertToken (Node AS INTEGER)
DECLARE SUB ChkForSpcl (CurPos AS INTEGER, EndPos AS INTEGER)
DECLARE SUB ChkForInclude (StartPos AS INTEGER, EndPos AS INTEGER)
DECLARE SUB CrossRef ()
DECLARE SUB CreateNode (Node AS INTEGER)
DECLARE SUB AnalyzeToken (SkipFlag AS INTEGER)
DECLARE SUB ListToken (Node AS INTEGER)
DECLARE SUB ShowUsage ()
DECLARE SUB Traverse ()
DECLARE SUB FormatOut ()
DECLARE SUB Titles (SubTitle AS STRING)
DECLARE SUB PrintList ()
'
'   Adjust Stack Size for Recursive (SUBS/FUNCS)
'
CLEAR , , 4096
'
'   Global Variable Definitions
'
DIM SHARED InFileName AS STRING             ' Input File Name
DIM SHARED Infile AS INTEGER                ' Input File Number
DIM SHARED ProgName AS STRING               ' Program Name without PATH
DIM SHARED OutFileName AS STRING            ' Output File Name
DIM SHARED OutFile AS INTEGER               ' Output File Number
DIM SHARED InclFile AS INTEGER              ' Current Include File Number
DIM SHARED ListLine AS INTEGER              ' Current Listing Line Number
DIM SHARED ListWidth AS INTEGER             ' Listing Width
DIM SHARED PageNbr AS INTEGER               ' Current Page Number on List
DIM SHARED StmtLen AS INTEGER               ' Length of Current Statement
DIM SHARED CurrStmt AS INTEGER              ' Current Statement Line Number
DIM SHARED TabSize AS INTEGER               ' Number of Chars per TAB
DIM SHARED LinesOnPage AS INTEGER           ' Number of Lines Per Page
DIM SHARED WideList AS INTEGER              ' True If Wide Listing
DIM SHARED WideOn AS STRING * 2             ' Enable Wide List on PRN
    WideOn = CHR$(27) + "M"
DIM SHARED WideOff AS STRING * 2            ' Disable Wide List on PRN
    WideOff = CHR$(27) + "@"
DIM SHARED KeyWords AS INTEGER              ' True If KeyWords To Print
DIM SHARED ListOnly AS INTEGER              ' True If Listing Only
DIM SHARED CrefOnly AS INTEGER              ' True If Cross Reference Only
DIM SHARED Include AS INTEGER               ' True If $INCLUDE: processing
DIM SHARED ErrFlag AS INTEGER               ' Global Error Flag
DIM SHARED TokenType AS INTEGER             ' Current Token Type
DIM SHARED WasGo AS INTEGER                 ' True If last KeyWord was GOTO
DIM SHARED HaveKeyWd AS INTEGER             ' True If KeyWord Found
DIM SHARED NextNode AS INTEGER              ' Next Element in Token Tree
DIM SHARED RootNode AS INTEGER              ' Root Element in Token Tree
DIM SHARED Nodes AS INTEGER                 ' Number of Nodes to Allocate
DIM SHARED Top AS INTEGER                   ' Top Of Stack Pointer
DIM SHARED CurrNode AS INTEGER              ' Current Node To Process
DIM SHARED StackPtr AS INTEGER              ' Current Stack Pointer
DIM SHARED Remark AS INTEGER                ' True if Remark Being Processed
DIM SHARED CrefType AS INTEGER              ' Type Of Cross Ref To Print
DIM SHARED LabelPos AS INTEGER              ' Next Position for A label
DIM SHARED Token AS STRING * MaxTokenSz     ' Current Token Being Processed
DIM SHARED Stmt AS STRING                   ' Current Source Statement
'
'   Global Array Definitions
'
DIM SHARED Stack(1 TO MaxNode) AS StackNode ' Traversed Tree Node Stack
'
'   Main Program
'
PRINT "MAT Enterprises, BASIC Cross Reference Utility  Version "; Version

ON ERROR GOTO ErrorHandler

IF NOT HaveCmdParams THEN
    CALL ShowUsage
ELSE
    DIM SHARED Tokens(1 TO Nodes) AS TokenNode      ' Tokens Binary Tree
    DIM SHARED Refs(1 TO Nodes) AS STRING           ' Token Line References
    ErrFlag = IsSpecial(Token)                      ' Initialize Tables
    CALL SetCtrlC
    CALL CrossRef
    END
END IF

'
'   Error Handler For LoadSrc FUNCTION
'
ErrorHandler:
    CONST FileNotFound = 53

    ErrFlag = TRUE
    IF ERR = FileNotFound AND ERL = 1000 THEN RESUME NEXT
    IF ERR = FileNotFound THEN
        PRINT InFileName; " File Not Found"
        RESUME NEXT
    END IF
    ON ERROR GOTO 0

'
' KeyWords With More Than One Part
'
DATA /CALL/"[ ABSOLUTE| INTERRUPT|]"
DATA /COM/"[ ON| OFF| STOP|]"
DATA /DEF/"[ SEG| FN|]"
DATA /END/"[ DEF| FUNCTION| IF| SELECT| SUB| TYPE|]"
DATA /INPUT/"[ #|]"
DATA /KEY/"[ ON| OFF| STOP|]"
DATA /LINE/"[ INPUT|]"
DATA /ON/"[ COM| KEY| PEN| PLAY| STRIG| TIMER| UEVENT| ERROR| GOSUB| GOTO|]"
DATA /OPEN/"[ COM|]"
DATA /OPTION/"[ BASE|]"
DATA /PEN/"[ ON| OFF| STOP|]"
DATA /PLAY/"[ ON| OFF| STOP|]"
DATA /PRINT/"[ #| USING|]"
DATA /RESUME/"[ NEXT|]"
DATA /SELECT/"[ CASE|]"
DATA /STRIG/"[ ON| OFF| STOP|]"
DATA /TIMER/"[ ON| OFF| STOP|]"
DATA /UEVENT/"[ ON| OFF| STOP|]"
DATA ""

FUNCTION Abort
PRINT : PRINT "Program Aborted..."
Abort = TRUE
END
END FUNCTION

REM $DYNAMIC
SUB AnalyzeToken (SkipFlag AS INTEGER) STATIC

IF (Remark AND (LEFT$(Token, 1) <> "$")) THEN
    SkipFlag = TRUE
ELSE
    SELECT CASE TokenType
        CASE Ident
            IF NOT HaveKeyWd THEN HaveKeyWd = IsKeyWord
            IF NOT ListOnly THEN
                IF KeyWords THEN
                    CALL InsertToken(RootNode)
                ELSE
                    IF NOT HaveKeyWd THEN CALL InsertToken(RootNode)
                END IF
            END IF
            IF HaveKeyWd THEN
                SELECT CASE RTRIM$(Token)
                    CASE "GOTO", "GOSUB", "RESUME", "THEN", "ELSE"
                        WasGo = TRUE
                    CASE "DATA"
                        WasGo = FALSE
                        SkipFlag = TRUE
                    CASE "REM"
                        WasGo = FALSE
                        Remark = TRUE
                    CASE ELSE
                        WasGo = LEFT$(Token, 2) = "ON"
                END SELECT
            END IF
        CASE Label
            IF NOT ListOnly THEN CALL InsertToken(RootNode)
    END SELECT
END IF

END SUB

SUB BldIdent (StartPos AS INTEGER, EndPos AS INTEGER) STATIC

CONST Valids = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!#$%&-"

FOR EndPos = StartPos TO StmtLen
    IF INSTR(1, Valids, UCASE$(MID$(Stmt, EndPos, 1))) = 0 THEN EXIT FOR
NEXT EndPos

Token = MID$(Stmt, StartPos, EndPos - StartPos)
CALL ChkForSpcl(StartPos, EndPos)
TokenType = Ident
WasGo = (EndPos <= LabelPos)
END SUB

SUB BldLabel (StartPos AS INTEGER, EndPos AS INTEGER) STATIC

STATIC Ch AS STRING * 1
CONST Terminators = " :,    "

IF ((WasGo) OR (StartPos = 1)) AND (StartPos >= LabelPos) THEN
    TokenType = Label
    FOR EndPos = StartPos TO StmtLen
        Ch = MID$(Stmt, EndPos, 1)
        IF INSTR("0123456789", Ch) = 0 THEN
            IF INSTR(1, Terminators, Ch) = 0 THEN TokenType = NUL
            EXIT FOR
        END IF
    NEXT EndPos
    IF TokenType THEN RSET Token = MID$(Stmt, StartPos, EndPos - StartPos)
ELSE
    EndPos = StartPos + 1
END IF

END SUB

SUB BldLiteral (StartPos AS INTEGER, EndPos AS INTEGER) STATIC

TokenType = Literal

FOR EndPos = StartPos + 1 TO StmtLen
    IF INSTR("ABCDEFH0123456789abcdefh", MID$(Stmt, EndPos, 1)) THEN EXIT FOR
NEXT EndPos
END SUB

SUB ChkForInclude (StartPos AS INTEGER, EndPos AS INTEGER)

STATIC FileName AS STRING

IF MID$(Token, 1, 1) = "$" THEN
    IF (RTRIM$(Token) <> "$INCLUDE") THEN EXIT SUB
ELSE
    EXIT SUB
END IF

I% = INSTR(EndPos + 1, Stmt, "'") + 1
IF I% = 1 THEN EXIT SUB
L% = INSTR(I%, Stmt, "'")
IF L% = 0 THEN EXIT SUB

L% = L% - I%

FileName = UCASE$(MID$(Stmt, I%, L%))
I% = FREEFILE

1000  OPEN FileName FOR INPUT AS #I%            'Trap if Error

IF ErrFlag THEN
    IF CrefOnly THEN PRINT
    PRINT "$INCLUDE: '"; FileName; "' Not Found"
    IF CrefOnly THEN PRINT ProgName; "(";
ELSE
    InclFile = I%
    EndPos = StmtLen
END IF

END SUB

SUB ChkForSpcl (CurPos AS INTEGER, EndPos AS INTEGER) STATIC

STATIC TmpTok AS STRING
STATIC NextWord AS STRING
STATIC LastPos AS INTEGER
STATIC SrchStr AS STRING
STATIC NextPos AS INTEGER
STATIC Length AS INTEGER

TmpTok = UCASE$(RTRIM$(Token))

IF NOT IsSpecial(NextWord) THEN
    EXIT SUB
ELSE
    HaveKeyWd = FALSE
END IF

LastPos = INSTR(CurPos, Stmt, CHR$(&H22))
LabelPos = INSTR(CurPos, Stmt, "'")
IF LabelPos < LastPos THEN LastPos = LabelPos
LabelPos = INSTR(CurPos, Stmt, ":")
IF LabelPos < LastPos THEN LastPos = LabelPos
IF LastPos = 0 THEN LastPos = StmtLen
NextPos = 1

DO
    NextPos = INSTR(NextPos, NextWord, " ")
    IF NextPos THEN
        Length = INSTR(NextPos, NextWord + "|", "|") - NextPos
        SrchStr = MID$(NextWord, NextPos, Length)
        LabelPos = INSTR(EndPos, Stmt, SrchStr)
        IF LabelPos AND LabelPos < LastPos THEN
            TmpTok = TmpTok + SrchStr
            HaveKeyWd = TRUE
            IF (SrchStr <> " FN") THEN
                MID$(Stmt, LabelPos, Length) = SPACE$(Length)
            END IF
        END IF
        NextPos = NextPos + Length - 1
    END IF
LOOP WHILE NextPos AND NOT HaveKeyWd

Token = TmpTok
END SUB

SUB CreateNode (Node AS INTEGER) STATIC

IF (NextNode > MaxNode) THEN
    PRINT "Maximum References Reached"
    EXIT SUB
ELSE
    NextNode = NextNode + 1
    Node = NextNode
    IF (RootNode = NUL) THEN RootNode = 1
END IF

Tokens(Node).Left = NUL
Tokens(Node).Right = NUL
Tokens(Node).Flag = CHR$(HaveKeyWd AND &HF0 OR TokenType)
Tokens(Node).Token = Token
Refs(Node) = MKI$(CurrStmt)
END SUB

SUB CrossRef STATIC

STATIC SkipFlag AS INTEGER              ' True if comment active
STATIC TStart AS INTEGER                ' Start Position of Token
STATIC TEnd AS INTEGER                  ' End Position of Token
STATIC Ch AS STRING * 1

Infile = FREEFILE
OPEN InFileName FOR INPUT AS #Infile

IF ErrFlag THEN EXIT SUB

OutFile = FREEFILE                      ' Gen Next File Number
OPEN OutFileName FOR OUTPUT AS OutFile

IF ErrFlag THEN
    CLOSE #Infile
    EXIT SUB
END IF

IF WideList THEN
    ListWidth = WideSize
    IF OutFileName = "PRN" THEN PRINT #OutFile, WideOn;
ELSE
    ListWidth = 80
END IF

WIDTH #OutFile, ListWidth
PageNbr = 0
ListLine = LinesOnPage
CurrStmt = 0
FOR TEnd = LEN(InFileName) TO 1 STEP -1
    Ch = MID$(InFileName, TEnd, 1)
    IF INSTR("\:", Ch) THEN EXIT FOR
    ProgName = Ch + ProgName
NEXT TEnd

IF CrefOnly THEN PRINT ProgName; "(";

DO WHILE NOT EOF(Infile)
    IF NOT InclStmt THEN LINE INPUT #Infile, Stmt
    IF NOT EOF(Infile) THEN
        LabelPos = 0
        WasGo = FALSE
        CurrStmt = CurrStmt + 1
        StmtLen = LEN(Stmt)
        IF NOT CrefOnly THEN CALL PrintList
        TStart = 1
        TEnd = 1
        Remark = FALSE
        SkipFlag = FALSE
        DO WHILE (TStart <= StmtLen)
            IF GetToken(TStart, TEnd) THEN
                CALL AnalyzeToken(SkipFlag)
                IF HaveKeyWd AND Remark THEN
                    CALL ChkForInclude(TStart, TEnd)
                END IF
            END IF
            IF SkipFlag THEN TStart = StmtLen + 1 ELSE TStart = TEnd + 1
        LOOP
        IF CrefOnly THEN
            IF (CurrStmt MOD 10 = 0) THEN
                X$ = LTRIM$(STR$(CurrStmt))
                PRINT X$; ")";
                LOCATE , POS(0) - LEN(X$) - 1
            END IF
        END IF
    END IF
LOOP

CLOSE #Infile
CALL FormatOut
END SUB

SUB FormatOut STATIC

IF NOT ListOnly THEN
    ListLine = LinesOnPage
    FOR CrefType = 1 TO 2
        Top = NUL                               ' Make TOP of Stack NUL
        StackPtr = NUL
        CurrNode = RootNode                     ' Start With Root Node
        IF (KeyWords) OR (CrefType = 2) THEN CALL Traverse
    NEXT CrefType
END IF

IF OutFileName = "PRN" THEN
    IF PageNbr THEN PRINT #OutFile, CHR$(12);
    PRINT #OutFile, WideOff;
END IF

CLOSE #OutFile
END SUB

FUNCTION GetToken (CurPos AS INTEGER, EndPos AS INTEGER) STATIC

TokenType = NUL
HaveKeyWd = FALSE
GetToken = TRUE

FOR CurPos = CurPos TO StmtLen
    SELECT CASE ASC(MID$(Stmt, CurPos, 1))
        CASE 65 TO 90, 97 TO 122                    '"A" TO "Z", "a" to "z"
            CALL BldIdent(CurPos, EndPos)
            EXIT FUNCTION
        CASE 48 TO 57                               '"0" TO "9"
            CALL BldLabel(CurPos, EndPos)
            EXIT FUNCTION
        CASE &H22                                   '"
            CurPos = INSTR(CurPos + 1, Stmt, CHR$(&H22))
            IF CurPos = 0 THEN CurPos = StmtLen
        CASE 38                                     '"&"
            CALL BldLiteral(CurPos, EndPos)
            EXIT FUNCTION
        CASE 36                                     '"$"
            IF Remark THEN
                CALL BldIdent(CurPos, EndPos)
                EXIT FUNCTION
            END IF
        CASE 39                                     '"'"
            Remark = TRUE
    END SELECT
NEXT CurPos
EndPos = CurPos
GetToken = FALSE
END FUNCTION

FUNCTION HaveCmdParams

LinesOnPage = DefLines
TabSize = DefTab
Nodes = MaxNode
Include = FALSE

C$ = RTRIM$(LTRIM$(COMMAND$))

DO WHILE C$ <> NULL$
    I% = INSTR(C$ + " ", " ")
    IF I% THEN
        P$ = LEFT$(C$, I% - 1)
        C$ = LTRIM$(MID$(C$, I% + 1))
        IF InFileName = NULL$ THEN
            InFileName = P$
            IF INSTR(P$, ".") = 0 THEN InFileName = InFileName + ".BAS"
            HaveCmdParams = TRUE
        ELSE
            IF LEFT$(P$, 1) <> "/" AND LEFT$(P$, 1) <> "-" THEN
                PRINT "Illegal Option "; P$
                HaveCmdParams = FALSE
                EXIT FUNCTION
            END IF

            SELECT CASE MID$(P$, 2, 1)
                CASE "C"
                    IF NOT ListOnly THEN
                        CrefOnly = TRUE
                    ELSE
                        PRINT "Conflicting Options /C /L"
                        HaveCmdParams = FALSE
                    END IF
                CASE "I"
                    Include = TRUE
                CASE "L"
                    IF NOT CrefOnly THEN
                        ListOnly = TRUE
                    ELSE
                        PRINT "Conflicting Options /C /L"
                        HaveCmdParams = FALSE
                    END IF
                CASE "K"
                    KeyWords = TRUE
                CASE "W"
                    WideList = TRUE
                CASE "O"
                    OutFileName = MID$(P$, 3)
                CASE "P", "T", "R"
                    I% = VAL(MID$(P$, 3))
                    SELECT CASE MID$(P$, 2, 1)
                        CASE "P"
                            LinesOnPage = I%
                        CASE "T"
                            TabSize = I%
                        CASE "R"
                            Nodes = I%
                    END SELECT
                CASE ELSE
                    PRINT "Unknown Option "; P$
                    HaveCmdParams = FALSE
            END SELECT
        END IF
    END IF
LOOP

IF LinesOnPage = 0 THEN LinesOnPage = DefLines
IF TabSize = 0 THEN TabSize = DefTab
IF Nodes = 0 THEN Nodes = MaxNode
IF OutFileName = NULL$ THEN OutFileName = "PRN"
C$ = NULL$
END FUNCTION

FUNCTION InclStmt

IF NOT Include THEN
    InclStmt = FALSE
    EXIT FUNCTION
END IF

IF InclFile > OutFile THEN
    LINE INPUT #InclFile, Stmt
    IF EOF(InclFile) THEN
        CLOSE #InclFile
        InclFile = InclFile - 1
        InclStmt = InclStmt
    ELSE
        InclStmt = TRUE
    END IF
ELSE
    InclStmt = FALSE
END IF

END FUNCTION

SUB InsertToken (Node AS INTEGER)

IF Node = NUL THEN
    CALL CreateNode(Node)
ELSE
    SELECT CASE NodeCmp(Token, Tokens(Node))
        CASE IS < 0
            CALL InsertToken(Tokens(Node).Left)
        CASE IS > 0
            CALL InsertToken(Tokens(Node).Right)
        CASE ELSE
            Refs(Node) = Refs(Node) + MKI$(CurrStmt)
    END SELECT
END IF
END SUB

FUNCTION IsKeyWord

STATIC TmpStr AS STRING

TmpStr = "/" + UCASE$(RTRIM$(Token)) + "/"
IF CkKeyWd(TmpStr) THEN
    Token = MID$(TmpStr, 2, LEN(TmpStr) - 2)
    IsKeyWord = TRUE
ELSE
    IsKeyWord = FALSE
END IF
END FUNCTION

FUNCTION IsSpecial (NextWord AS STRING) STATIC

CONST SpclSize = 800

STATIC SpclWrds AS STRING * SpclSize
STATIC TmpStr AS STRING
STATIC Indx AS INTEGER
STATIC Length AS INTEGER

IF ASC(SpclWrds) = NUL THEN
    Indx = 1
    DO
        READ TmpStr
        IF (TmpStr <> NULL$) THEN
            MID$(SpclWrds, Indx, LEN(TmpStr)) = TmpStr
            Indx = Indx + LEN(TmpStr)
        END IF
    LOOP UNTIL TmpStr = NULL$
END IF

IsSpecial = FALSE
Indx = INSTR(SpclWrds, "/" + UCASE$(LEFT$(Token, 1)))
IF Indx THEN
    TmpStr = "/" + UCASE$(RTRIM$(Token)) + "/"
    Indx = INSTR(Indx, SpclWrds, TmpStr)
    IF Indx THEN
        Indx = INSTR(Indx, SpclWrds, "[")
        Length = INSTR(Indx, SpclWrds, "]") - Indx + 1
        NextWord = MID$(SpclWrds, Indx, Length)
        IsSpecial = TRUE
    END IF
END IF
END FUNCTION

SUB ListToken (Node AS INTEGER) STATIC

CONST FrstRefPos = 20

STATIC TStr AS STRING
STATIC Indx AS INTEGER
STATIC CurPos AS INTEGER
STATIC SubTitle AS STRING
STATIC LastType AS INTEGER

IF ASC(Tokens(Node).Flag) AND &HF0 THEN
    IF CrefType = 2 THEN EXIT SUB
ELSE
    IF CrefType = 1 THEN EXIT SUB
END IF

IF CrefType <> LastType THEN
    LastType = CrefType
    SELECT CASE CrefType
        CASE 1
            SubTitle = "BASIC Keywords"
        CASE 2
            SubTitle = RTRIM$(ProgName) + " References"
    END SELECT
    IF ListLine + 4 < LinesOnPage THEN
        PRINT #OutFile,
        PRINT #OutFile, SubTitle
        PRINT #OutFile,
        ListLine = ListLine + 3
    END IF
END IF

CALL Titles(SubTitle)
IF (ASC(Tokens(Node).Flag) AND &HF) = Label THEN
    TStr = RTRIM$(LTRIM$(Tokens(Node).Token))
ELSE
    TStr = RTRIM$(Tokens(Node).Token)
END IF
PRINT #OutFile, TStr; TAB(FrstRefPos);
IF LEN(TStr) >= FrstRefPos THEN ListLine = ListLine + 1
CurPos = FrstRefPos
TStr = Refs(Node)

FOR Indx = 1 TO LEN(TStr) STEP 2
    IF (CurPos + 5 > ListWidth) THEN
        PRINT #OutFile,
        CALL Titles(SubTitle)
        CurPos = FrstRefPos
        PRINT #OutFile, TAB(FrstRefPos);
    END IF
    PRINT #OutFile, USING "#### "; CVI(MID$(TStr, Indx, 2));
    CurPos = CurPos + 5
NEXT Indx

PRINT #OutFile,
END SUB

SUB PrintList STATIC

CONST FrstPos = 6

STATIC CurPos AS INTEGER
STATIC Ch AS STRING * 1

CALL Titles(NULL$)
PRINT #OutFile, USING "#### "; CurrStmt;
CurPos = FrstPos

FOR I% = 1 TO StmtLen
    IF (CurPos + 1 > ListWidth) THEN
        PRINT #OutFile,
        CALL Titles(NULL$)
        PRINT #OutFile, TAB(FrstPos);
        CurPos = FrstPos
    END IF

    Ch = MID$(Stmt, I%, 1)
    IF (Ch = CHR$(9)) THEN
        J% = TabSize - ((CurPos - FrstPos) MOD TabSize)
        CurPos = CurPos + J%
        DO WHILE (J% > 0)
            PRINT #OutFile, " ";
            J% = J% - 1
        LOOP
    ELSE
        CurPos = CurPos + 1
        PRINT #OutFile, Ch;
    END IF
NEXT I%

PRINT #OutFile,
END SUB

SUB ShowUsage STATIC

PRINT CHR$(10); "Usage: QBCREF FileName [Options]"; CHR$(10)
PRINT "Options : (Separated by Space)"
PRINT "/C      = Cross Reference Only"
PRINT "/I      = Enable $INCLUDE: Metacommand"
PRINT "/L      = Listing Only (Default List & Cref)"
PRINT "/OFile  = Output Filename"
PRINT "/Pnn    = Page Size (Default"; STR$(DefLines); " Lines)"
PRINT "/Rnnnn  = Number of References (Default"; STR$(MaxNode); ")"
PRINT "/K      = Include BASIC Key Words"
PRINT "/Tn     = Tab Size (Default"; STR$(DefTab); ")"
PRINT "/W      = Wide Listing (Default Narrow)"

END SUB

SUB Titles (SubTitle AS STRING) STATIC

STATIC Hdr AS STRING

IF PageNbr = 0 THEN
    X$ = "BASIC Cross Reference of " + ProgName
    I% = (ListWidth - LEN(X$) - 18) \ 2
    Hdr = DATE$ + SPACE$(I%) + X$
END IF

ListLine = ListLine + 1

IF (ListLine >= LinesOnPage) THEN
    ListLine = 0
    PageNbr = PageNbr + 1
    IF (OutFileName = "PRN") AND (PageNbr > 1) THEN PRINT #OutFile, CHR$(12);
    PRINT #OutFile, Hdr; TAB(ListWidth - 8); "Page";
    PRINT #OutFile, USING "###"; PageNbr
    IF SubTitle <> NULL$ THEN PRINT #OutFile, SubTitle
    PRINT #OutFile,
END IF

END SUB

SUB Traverse

DO WHILE (CurrNode <> NUL)
    StackPtr = StackPtr + 1
    Stack(StackPtr).NodeLink = CurrNode
    Stack(StackPtr).StackLink = Top
    Top = StackPtr
    CurrNode = Tokens(CurrNode).Left
LOOP

IF (Top <> NUL) THEN
    CurrNode = Stack(Top).NodeLink
    Top = Stack(Top).StackLink
    CALL ListToken(CurrNode)
    CurrNode = Tokens(CurrNode).Right
    Traverse
END IF

END SUB